home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Utilities / GOCR / gocr.tcl < prev    next >
Text File  |  2000-05-29  |  5KB  |  169 lines
  1. # menu frame
  2. # image gif ppm pgm
  3.  
  4. frame .mbar -borderwidth 1 -relief raised
  5. pack .mbar -fill x
  6.  
  7. menubutton .mbar.file -text "File" -menu .mbar.file.m
  8. pack .mbar.file -side left
  9. menu .mbar.file.m
  10. .mbar.file.m add command -label "Exit" -command exit
  11.  
  12.  
  13. set spacewidth 0
  14. set graylevel 160
  15. set dustsize 20
  16. set file "text.pbm"
  17. menubutton .mbar.options -text "Options" -menu .mbar.options.m
  18. pack .mbar.options -side left
  19. menu .mbar.options.m
  20. .mbar.options.m add command -label "set spacewidth ($spacewidth)"
  21. .mbar.options.m add command -label "set graylevel ($graylevel)"
  22. .mbar.options.m add command -label "set dustsize ($dustsize)"
  23. .mbar.options.m add cascade -menu .mbar.options.m.verbose -label "Verbose"
  24. .mbar.options.m add cascade -menu .mbar.options.m.mode    -label "Mode"
  25. .mbar.options.m add command -label "Save options"
  26. menu .mbar.options.m.mode
  27. set m .mbar.options.m.mode
  28. set m3 0
  29. set m4 0
  30. set m5 0
  31. $m add check -label "use database"       -variable m1 -onvalue  2 -offvalue  0
  32. $m add check -label "layout analysis"    -variable m2 -onvalue  4 -offvalue  0
  33. $m add check -label "compare _ mode"     -variable m3 -onvalue  0 -offvalue  8
  34. $m add check -label "divide  _ mode"     -variable m4 -onvalue  0 -offvalue 16
  35. $m add check -label "context correction" -variable m5 -onvalue  0 -offvalue 32
  36. $m add check -label "char packing"       -variable m6 -onvalue 64 -offvalue  0
  37. menu .mbar.options.m.verbose
  38. set m .mbar.options.m.verbose
  39. $m add check -label "more info"        -variable v0 -onvalue  1 -offvalue 0
  40. $m add check -label "list chapes"      -variable v1 -onvalue  2 -offvalue 0
  41. $m add check -label "list pattern"     -variable v2 -onvalue  4 -offvalue 0
  42. $m add check -label "list all pattern" -variable v3 -onvalue  8 -offvalue 0
  43. $m add check -label "line infos"       -variable v4 -onvalue 16 -offvalue 0
  44. $m add check -label "debug mode"       -variable v5 -onvalue 32 -offvalue 0
  45.  
  46. menubutton .mbar.help -text "Help" -menu .mbar.help.m
  47. pack .mbar.help -side right
  48. menu .mbar.help.m
  49. .mbar.help.m add command -label "About" -command aboutBox
  50. # .mbar.help.m add command -label "Version"
  51.  
  52. # --------------------- action frame -----------------------
  53. frame .abar -borderwidth 1 -relief sunken
  54. pack .abar -fill x
  55.  
  56. set but [button .abar.go -text "Run it" -command Run]
  57. #button .abar.go -text "Run it" -command { Run }
  58. pack .abar.go -side left
  59.  
  60. label .abar.labf -text "File:"
  61. entry .abar.entf -width 20
  62. pack .abar.labf -side left
  63. pack .abar.entf -side left
  64. .abar.entf insert 0 $file
  65.  
  66. label .abar.status -text "ready"
  67. pack .abar.status -side right
  68.  
  69. # ------------------ canvas, text ? -----------------
  70. #canvas .pad -background white
  71. #pack .pad
  72.  
  73. frame .t
  74. #text .t
  75. #pack .t
  76. ##.t insert end "history:"
  77. ##.t configure -state disabled
  78.  
  79.  
  80. set log [text .t.log -width 80 -height 10 \
  81.   -borderwidth 2 -relief raised -setgrid true\
  82.   -yscrollcommand {.t.scroll set}]
  83. scrollbar .t.scroll -command {.t.log yview}
  84. pack .t.scroll -side right -fill y
  85. pack .t.log -side left -fill both -expand true
  86. pack .t -side top -fill both -expand true
  87.  
  88. bind .abar.entf <Return> Run
  89. bind .abar.entf <Control-c> Stop
  90. focus .abar.entf
  91.  
  92.  
  93. tk_messageBox -icon info -type ok -title "Info" -message \
  94.   "This program is in development!\nUse carefully!\n"
  95.  
  96.  
  97. # --------------------- run ---------------------
  98. proc Run {} {
  99.   global fid but log file v0 v1 v2 v3 v4 m1 m2 m3 m4 m5 m6 spacewidth graylevel dustsize
  100.   .abar.status configure -text "progress"
  101. #  .abar.go configure -state disabled
  102.   update
  103.   set file [.abar.entf get]
  104.   set vvv  [expr $v0 + $v1 + $v2 + $v3 + $v4 ]
  105.   set mode [expr $m1 + $m2 + $m3 + $m4 + $m5 + $m6 ]
  106.   set run "gocr -i $file -v $vvv -m $mode -s $spacewidth -l $graylevel -d $dustsize"
  107. #  puts $run
  108. #  .t configure -state normal
  109. #  .t insert end "\n$run"
  110. #  .t configure -state disabled
  111. #  update
  112. # after 1000
  113. # exec $run
  114. # -- or --
  115. #  set fid [ open "| $run" "r" ]
  116.   if [catch {open "| $run |& cat" } fid] {
  117.     $log insert end $fid\n
  118.   } else {
  119.     fileevent $fid readable Log
  120.     $log insert end $run\n
  121.     $but config -text "Stop !" -command Stop
  122.   }
  123. ## gets $fid ; # ead headerline
  124. #  fileevent $fid readable "get_samples $fid"
  125. }
  126.  
  127. proc Log {} {
  128.   global fid log
  129.   if [eof $fid] { Stop } else {
  130.     gets $fid line
  131.     $log insert end $line\n
  132.     $log see end
  133.   }
  134. }
  135.  
  136. proc Stop {} {
  137.   global fid but
  138.   catch {close $fid}
  139.   $but config -text "Run it" -command Run
  140.   .abar.status configure -text "ready"
  141.   update
  142. }
  143.  
  144. #proc get_samples {fid} {
  145. #   if {[gets $fid line] >= 0} {
  146. ##     puts "$line" 
  147. ##    .t configure -state normal
  148. #    .t insert end "$line\n"
  149. ##    .t configure -state disabled
  150. #    update
  151. #   } else {
  152. #     close $fid 
  153. #     .abar.status configure -text "ready"
  154. #     .abar.go configure -state normal
  155. #     update
  156. #   }
  157. #}
  158.  
  159.  
  160. # aboutBox --
  161. #
  162. #       Pops up a message box with an "about" message
  163. #
  164. proc aboutBox {} {
  165.      tk_messageBox -icon info -type ok -title "About" -message \
  166.     "Tcl/Tk Front End\n to GOCR v0.2\n\n v0.1 (c) 2000 JS"
  167. }
  168.  
  169.